Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/slock/dlltest1.pas

Pascal/Delphi Source File | 1998-08-17 | 9KB | 260 lines

unit dlltest1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, SlokUtil;

type
  TfrmBufferTools = class(TForm)
    grpBuffer: TGroupBox;
    mmoBuffer: TMemo;
    btnShowBuffer: TButton;
    grpFindBuffer: TGroupBox;
    btnFindBuffer: TButton;
    lblFindExpl: TLabel;
    lblOffsetLabel: TLabel;
    lblOffsetData: TLabel;
    grpWriteBuffer: TGroupBox;
    btnWriteBuffer: TButton;
    lblWriteExpl: TLabel;
    grpDLLName: TGroupBox;
    edtDLLName: TEdit;
    lblDLLExpl: TLabel;
    procedure btnShowBufferClick(Sender: TObject);
    procedure btnFindBufferClick(Sender: TObject);
    procedure btnWriteBufferClick(Sender: TObject);
  end;

var
  frmBufferTools: TfrmBufferTools;

implementation

{$R *.DFM}

{*******************************************************************************
* Procedure : btnShowBufferClick                                               *
********************************************************************************
* Purpose   : Shows the contents of the buffer in the DLL                      *
********************************************************************************
* Paramters : None                                                             *
********************************************************************************
* Returns   : None                                                             *
*******************************************************************************}
procedure TfrmBufferTools.btnShowBufferClick(Sender: TObject);
type
     TGetRegInfo = function: TBuffer; stdcall;
var
     GetRegInfo: TGetRegInfo;
     MyHandle: THandle;
     Buffer: TBuffer;
     BufferString: string;
     i: integer;
     DLLNameHelper: PChar;
begin
     // clear the memo
     mmoBuffer.Clear;

     // get the name of the DLL in the right (PChar) form
     DLLNameHelper := AllocMem(255);
     StrPCopy(DLLNameHelper, edtDLLName.Text);

     // get the handle of the DLL and attempt to load
     MyHandle := LoadLibrary(DLLNameHelper);
     if MyHandle <> 0 then
     begin
          // if the load was successful, get the address of the GetRegInfo function
          @GetRegInfo := GetProcAddress(MyHandle, 'GetRegInfo');

          // if the address is valid
          if @GetRegInfo <> nil then
          begin
               // get the buffer
               Buffer := GetRegInfo;

               // output the buffer
               for i := 0 to 255 do
               begin
                    BufferString := BufferString + IntToHex(Buffer[i],2) + ' ';
                    if ((i mod 16) = 15) then
                    begin
                         mmoBuffer.Lines.Add(BufferString);
                         BufferString := '';
                    end;
               end;
          end
          else
          begin
               mmoBuffer.Lines.Add('Error reading buffer');
          end;

     // tidy up
     FreeLibrary(MyHandle);
     FreeMem(DLLNameHelper);
     end;
end;

{*******************************************************************************
* Procedure : btnFindBufferClick                                               *
********************************************************************************
* Purpose   : Finds the start position (offset) of the buffer in the DLL       *
********************************************************************************
* Paramters : None                                                             *
********************************************************************************
* Returns   : None                                                             *
*******************************************************************************}
procedure TfrmBufferTools.btnFindBufferClick(Sender: TObject);
var
     OutputFile: File of Byte;
     b,c,d: Byte;
     Counter: integer;
begin
     // check if the DLL is in the current directory
     if not FileExists(edtDLLName.Text) then
     begin
          // the DLL was not found
          ShowMessage('The DLL was not found - it must be in the same directory as this project to test it!');
          Exit;
     end; {if}

     // tell us what's going on
     lblOffsetData.Caption := 'Searching... (will take a moment)';
     lblOffsetData.Repaint;

     try
          AssignFile(OutputFile, edtDLLName.Text);
     except
          // we could not open the output file for some reason
          // so exit gracefully with an error code
          CloseFile(OutputFile);
          Exit;
     end;

     // reset the output file
     FileMode := 2;
     Reset(OutputFile);

     Counter := -1;

     // locate the right place in the file
     while not EOF(OutputFile) do
     begin
          Inc(Counter);
          Read(OutputFile,b);
          if b = Ord('B') then
          begin
               Read(OutputFile,b,c,d);
               if ((b = ORD('u')) and (c = Ord('f')) and (d = ORD(':'))) then
               begin
                    // display the offset of the buffer from file start
                    lblOffsetData.Caption := IntToStr(Counter + 4);
                    CloseFile(OutputFile);
                    Exit;
               end
               else
               begin
                    Inc(Counter,3);
               end;
          end;
     end;
     lblOffsetData.Caption := 'Not Found!!';
     CloseFile(OutputFile);
end;

{*******************************************************************************
* Procedure : btnWriteBufferClick                                              *
********************************************************************************
* Purpose   : Writes into the buffer                                           *
********************************************************************************
* Paramters : None                                                             *
********************************************************************************
* Returns   : None                                                             *
*******************************************************************************}
procedure TfrmBufferTools.btnWriteBufferClick(Sender: TObject);
type
     TGetBuffAddr = function(DLLName: PChar): integer; stdcall;
var
     GetBuffAddr: TGetBuffAddr;
     MyHandle: THandle;
     DLLNameHelper: PChar;
     OutputFile: File of Byte;
     b: Byte;
     i: integer;
     BuffOffset: Integer;
begin
     // check if the DLL is in the current directory
     if not FileExists(edtDLLName.Text) then
     begin
          // the DLL was not found
          ShowMessage('The DLL was not found - it must be in the same directory as this project to test it!');
          Exit;
     end; {if}

     // initialise
     BuffOffset := 0;

     // get the name of the DLL in the right (PChar) form
     DLLNameHelper := AllocMem(255);
     StrPCopy(DLLNameHelper, edtDLLName.Text);

     // get the handle to the DLL and load it
     MyHandle := LoadLibrary(DLLNameHelper);
     if MyHandle <> 0 then
     begin
          // if we were successful, get the address of the function
          @GetBuffAddr := GetProcAddress(MyHandle, 'GetBuffAddr');
          if @GetBuffAddr <> nil then
          begin
               // get the offset from the DLL
               BuffOffset := GetBuffAddr(DLLNameHelper);
          end;
     end
     else
     begin
         // no dll found - tell the user and exit
         ShowMessage('DLL not found!');
         FreeLibrary(MyHandle);
         FreeMem(DLLNameHelper);
         Exit;
     end;

     // update the display
     lblOffsetData.Caption := IntToStr(BuffOffset);

     // tidy up
     FreeLibrary(MyHandle);
     FreeMem(DLLNameHelper);

     // write into the DLL
     try
          AssignFile(OutputFile, edtDLLName.Text);
     except
          // we could not open the output file for some reason
          // so exit gracefully with an error code
          CloseFile(Outpu